(in-package :com.ozten.conway)

(defvar *last-evt* nil)
(defvar *cells* nil)

(defclass cells ()
((cells :initarg :cells :accessor :cells)))

(defclass cell ()
((x :initarg :x :accessor :x)
 (y :initarg :y :accessor :y)
 (fn :accessor :fn)   ; function to advance this cell to the next step
 (canvas :initarg :canvas)
 (oval :initarg :oval)
 (alive :initarg :alive :initform nil
	:accessor :alive)))


(defun make-cells-array (num-cols num-rows canvas)
  (let ((cells-array (make-array num-cols)))
    (loop for col from 0 to (1- num-cols) do
	  (setf (elt cells-array col) (make-array num-rows))
	  (loop for row from 0 to (- num-rows 1) do 
		(setf (elt (elt cells-array col) row) 
		      (make-instance 'cell :x col :y row 
				     :canvas canvas 
				     :oval (create-oval canvas (* col 10) (* row 10) (+ (* col 10) 10) (+ (* row 10) 10))
				     :alive nil))))
    cells-array))
					;
					;(if (evenp col) (setf (slot-value (elt (elt cells-array row) col) 'alive) nil


(defun main-life ()
  (with-ltk ()
    (let* ((canvas (make-instance 'canvas :width 500 :height :500 :master nil))	    
	   (num-cols 10)
	   (num-rows 10)
	   (cells-array (make-cells-array num-cols num-rows canvas)))

					;populate row and column of grid with a cell
      (setf *cells* (make-instance 'cells :cells cells-array))

      (defun live (x y)
	(setf (slot-value (get-cell-at *cells* x y) 'alive) t))
      (live 3 3) (live 1 1) (live 2 1)
      (live 2 2) (live 1 2) (live 4 3)


      (bind canvas "<ButtonPress-1>"
	    (lambda (evt) 
	      (setf *last-evt* evt)
	      (format *standard-output* "~a" evt)))       
      (after 1166 #'(lambda () (draw-sim canvas)))
      (pack canvas))))

(defun draw-sim (canvas)
  (loop for rows across (slot-value *cells* 'cells) do
	(loop for cell across rows do
	      (draw cell)))
  (postscript canvas (format t "/Users/ozten/~a-conway.ps" (get-universal-time)))
  (after 300 #'(lambda () (draw-sim canvas)))
  (update *cells*))

(defun valid-cell-p (cells x y)
"Given a Cells object and coordinates, returns true
 if the cell location is valid, false otherwise"
(and 
 (and (>= x 0) (> (length (slot-value cells 'cells)) x))
 (and (>= y 0) (> (length (slot-value cells 'cells)) y))))




(defgeneric howdy (cells x y) 
(:documentation "Returns 1 if there is life, otherwise 0. If the
cell is an invalid location then 0 will be returned."))
(defmethod howdy ((cells cells) x  y)
(if (valid-cell-p cells x y)
    (if (slot-value (get-cell-at cells x y) 'alive) 1 0)
    0))

(defgeneric number-lively-neighboors (cells x y)
(:documentation "Given a Cells object and coordinates x y, Returns the number of lively neighbor cells"))
(defmethod number-lively-neighboors ((cells cells) x y)
(+ (howdy cells (1- x) (1- y))
   (howdy cells x      (1- y))
   (howdy cells (1+ x) (1- y))

   (howdy cells (1- x) y)
					;me    x y
   (howdy cells (1+ x) y)

   (howdy cells (1- x) (1+ y))
   (howdy cells x      (1+ y))
   (howdy cells (1+ x) (1+ y))))


(defgeneric lonelyp (cells x y)
(:documentation "Any live cell with fewer than two live neighbours dies, as if by loneliness. Returns true 
                   if this cell is lonely"))
(defmethod lonelyp ((cells cells) x y)
(let ((lively-neighboors (number-lively-neighboors cells x y)))
  (cond ((< lively-neighboors 2) t)
	(t nil))))

(defgeneric over-crowded-p (cells x y) 
(:documentation "Any live cell with more than three live neighbours dies, as if by overcrowding."))
(defmethod over-crowded-p ((cells cells) x y)   
(let ((lively-neighboors (number-lively-neighboors cells x y)))
  (cond ((> lively-neighboors 3) t)
	(t nil))))

(defgeneric staying-alive-p (cells x y)
(:documentation "Any live cell with two or three live neighbours lives, unchanged, to the next generation."))
(defmethod staying-alive-p ((cells cells) x y)
(let ((lively-neighboors (number-lively-neighboors cells x y)))
  (cond ((or (= lively-neighboors 3) 
	     (= lively-neighboors 2)) t)
	(t nil))))

(defgeneric re-animate-p (cells x y)
(:documentation "Any dead cell with exactly three live neighbours comes to life.
TODO: add check to see if x y is really dead..."))

(defmethod re-animate-p ((cells cells) x y)
(let ((lively-neighboors (number-lively-neighboors cells x y)))
  (cond ((= lively-neighboors 3) t)
	(t nil))))


(defmethod print-object ((object cell) stream)
(with-slots (x y alive) object
  (format t "Cell ~a ~a alive?=~a" x y alive)))

(defgeneric draw (cell))
(defmethod draw (cell)
  (let* ((canvas (slot-value cell 'canvas))
	 (oval (slot-value cell 'oval))
	 (x (slot-value cell 'x))
	 (y (slot-value cell 'y))
	 (alive (slot-value cell 'alive)))
    (if alive (progn 
		(itemconfigure canvas oval :fill "#CCCCCC")
		(set-coords canvas oval (list (+ (* x 40) (random 5)) (+ (* y 40) (random 5))
					      (+ (* x 40) 40)  (+ (* y 40) 40))))
	(set-coords canvas oval (list -10 -10 5 5)))))
    

(defgeneric next-step (cell function)
  (:documentation "Add a function to be be executed during the next step. 
                   function will receive a reference to this cell as the only
                   argument. lambda cell do-stuff cell would make a suitable 
                   function."))
(defmethod next-step (cell function)
  ; TODO support more than 1 fn
  (setf (slot-value cell 'fn) function))

(defgeneric do-next-steps (cell)
  (:documentation "Tells cell to advance to the next step and update it's internal state"))
(defmethod do-next-steps (cell)
  (funcall (slot-value cell 'fn) cell))

(defgeneric get-cell-at (cells x y)
(:documentation "Gets the cell at coordinates x y"))
(defmethod get-cell-at (cells x y)
(elt (elt (slot-value cells 'cells) y) x))

(defgeneric update (cells)
  (:documentation "Updates the state of the cells based on the rules
 of conway's game of life"))
(defmethod update (cells)
  (let ((max-x (1- (length (slot-value *cells* 'cells))))
	(max-y (1- (length (elt (slot-value *cells* 'cells) 0)))))
    (loop for x from 0 to max-x do
	  (loop for y from 0 to max-y do 
		(let* ((cell (get-cell-at *cells* x y))
		       (lonley (lonelyp *cells* x y))
		       (over-crowded (over-crowded-p *cells* x y))
		       (staying-alive (staying-alive-p *cells* x y))
		       (re-animate (re-animate-p *cells* x y)))
		  (cond ((or lonley over-crowded)
			 (next-step cell #'(lambda (cell) (setf (slot-value cell 'alive) nil))))
			((or staying-alive re-animate)
			 (next-step cell #'(lambda (cell) (setf (slot-value cell 'alive) t))))
			(t  (format *standard-output* "no action~%"))))))
    (loop for x from 0 to max-x do
	  (loop for y from 0 to max-y do 
		(let ((cell (get-cell-at *cells* x y)))
		  (do-next-steps cell))))))
			 
			
			
;;;(defparameter *recursive-squares-canvas* nil)
;;(defvar *canvas-width* 700)
;;(defvar *canvas-height* 500)
;;(defvar *game-running* t)		

;; (defun xpaint (canvas)
;; 					;  (loop while *game-running* do
;;   (progn
;;     (itemconfigure canvas (create-rectangle canvas 0 0 *canvas-width* *canvas-height*) :fill "#DDDDDD")
;;     (loop for x from 2 to *canvas-width* by 50 
;; 	  do (loop for y from 2 to *canvas-height* by 50
;; 		   do (let* ((hash-key (format nil "x~ay~a" x y))
;; 			     (alive (slot-value (gethash hash-key *cells-hash*) 'alive)))
;; 			(cond (alive
;; 			       (itemconfigure canvas (create-oval canvas x y (+ x 46) (+ y 46)) :fill "#CCCCCC"))))))
;;     (loop for x from 2 to *canvas-width* by 50 
;; 	  do (loop for y from 2 to *canvas-height* by 50
;; 		   do (let* ((hash-key (format nil "x~ay~a" x y))
;; 			     (lonley (lonelyp x y))
;; 			     (over-crowded (over-crowded-p x y))
;; 			     (staying-alive (staying-alive-p x y))
;; 			     (re-animate (re-animate-p x y)))
;; 			(cond (lonley
;; 			       (setf (gethash (format nil "x~ay~a" x y) *cells-next-tick-hash*) (make-instance 'cell :x x :y y)))
;; 			      (over-crowded 
;; 			       (setf (gethash (format nil "x~ay~a" x y) *cells-next-tick-hash*) (make-instance 'cell :x x :y y)))
;; 			      (re-animate
;; 			       ~			       (setf (gethash (format nil "x~ay~a" x y) *cells-next-tick-hash*) (make-instance 'cell :x x :y y :alive t)))
;; 			      (t
;; 			       (setf (gethash (format nil "x~ay~a" x y) *cells-next-tick-hash*) (gethash hash-key *cells-hash*)))))))
;;     (next-state-for-cells)))


(defun test-cgol ()
  (progn
    (format t "Testing howdy for cells~%")
    (format t "This should be 1=~a~%" (howdy 102 52))
  
    (format t "Testing number-lively-neighboors~%")
    (format t "3=~a~%" (number-lively-neighboors 102 52))
    (format t "4=~a~%" (number-lively-neighboors 152 102))
    (format t "0=~a~%" (number-lively-neighboors 252 52))
    (format t "1=~a~%" (number-lively-neighboors 252 152))

    (format t "Any live cell with fewer than two live neighbours dies, as if by loneliness.~%")
    (format t "t=~a~%" (lonelyp 252 152))
    (format t "nil=~a~%" (lonelyp 102 52))
    (format t "t=~a~%" (lonelyp 252 52))

    (format t "Any live cell with more than three live neighbours dies, as if by overcrowding.~%")
    (format t "Overcrowded false=~a~%" (over-crowded-p 252 52))
    (format t "Overcrowded true=~a~%" (over-crowded-p 152 102))

    (format t "Any live cell with two or three live neighbours lives, unchanged, to the next generation.~%")    
    (format t "true=~a~%" (staying-alive-p 152 52))
    (format t "false=~a~%" (staying-alive-p 252 52))

    (format t "Any dead cell with exactly three live neighbours comes to life.~%")
    (format t "true=~a~%" (re-animate-p 202 102))
    (format t "false=~a~%" (re-animate-p 252 102))

    (format t "Testing next state for cells")
    (setf (gethash (format nil "x~ay~a" 10 10) *cells-hash*) (make-instance 'cell :x 10 :y 10 :alive nil))
    (format t "This should be nil==~a~%" (slot-value (gethash (format nil "x~ay~a" 10 10) *cells-hash*) 'alive))
    (setf (gethash (format nil "x~ay~a" 10 10) *cells-next-tick-hash*) (make-instance 'cell :x 10 :y 10 :alive t))
    (next-state-for-cells)
    (format t "This should be t==~a~%" (slot-value (gethash (format nil "x~ay~a" 10 10) *cells-hash*) 'alive))
  

    ))
					;(test-cgol)


;#+ccl (ccl:process-run-function "main-life-proc" 'main-life)
;#-ccl (main-life)